home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 4 / Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso / Development / General / ViewIt™ 2.24 Shareware / FORTRAN Demo Projects / LS Fortran 3.3 Demos / vDemoLF.f < prev    next >
Text File  |  1994-02-24  |  4KB  |  134 lines
  1. C NOTE: Read the "MPW Fortrans" section of "About Compilers"
  2. C before compiling LF programs that use FaceWare modules.
  3.  
  4. C ViewIt 2.2 Demonstration Program
  5. C ©FaceWare 1991-93.  All Rights Reserved.
  6.  
  7. !!M Inlines.f
  8. !!I FaceProcLF.inc
  9.  
  10.       PROGRAM vDemoLF
  11.     implicit none
  12. C NOTE: If you use the "!!G" directive for precompiled globals, add
  13. C our FaceStorLF.inc globals to yours and then remove following line
  14.     include 'FaceStorLF.inc'
  15.       record /FaceRec/ fRec
  16.       common/FaceStuff/fRec
  17.     logical*4 helpShown
  18.     structure /DataRec/
  19.       integer*2 myInteger
  20.       real*4 myReal
  21.       character*100 myString
  22.       integer*4 myFlags
  23.     end structure
  24.     record /DataRec/ myRec
  25.     integer*2 myList
  26.     integer*4 myPtr,oldTicks,newTicks
  27.     real*4 theReal,delta
  28.     external OverProc
  29.  
  30.     myRec.myInteger = 0
  31.     myRec.myReal = 6.2
  32.     myRec.myString = 'Hello'
  33.     myRec.myFlags = 10
  34.     myList = 2
  35.     oldTicks = 0
  36.     theReal = 6.0
  37.  
  38. C Initialize FaceIt
  39.       fRec.uName = 'vDemo.Rsrc'
  40.       call FaceIt(0,DoInit,0,0,0,0)
  41.  
  42. C Open Modeless Window using FWND 1000
  43.     call FaceIt(0,NewWnd,1000,1,0,0)
  44.  
  45.       do while (.true.)
  46.         call FaceIt(0,DoLoop,0,0,0,0)
  47. C Standard "About" Menu Item Selection
  48.       if ((fRec.uMenuID = 101).and.(fRec.uMenuItem = 1)) then
  49.         fRec.uString = 'Demonstration of the use of ViewIt'
  50.      +//char(13)//'windows in a FaceIt-based program.'
  51.         call FaceIt(0,ShoStr,3,12,(1 + (409*65536)),0)
  52. C Hit in Modeless Window's "Open Modal" Button
  53.       else if ((fRec.uMenuID = 1000).and.(fRec.wcHit = 2)) then
  54.         call FaceIt(0,NewWnd,1001,0,0,0)  !Open Modal Window
  55.         do while (.true.)
  56.           call FaceIt(0,MdlWnd,1001,0,0,0)  !Process Modal Events
  57.         if (fRec.wcHit = -1) then        !Hit in Close Box
  58.           exit
  59.         else if (fRec.wcHit = 1) then     !Hit in "Open Nested"
  60.           myPtr = %loc(myRec)
  61.           call FaceIt(0,NewWnd,1002,0,110,myPtr)!Open Nested Modal
  62.           call FaceIt(0,GetCtl,1002,0,3,3)      !Link Scrollable List
  63.           call FaceIt(0,LnkCtl,fRec.cControl,%loc(myList),2,0)
  64.           call FaceIt(0,GetCtl,1002,0,2,3)      !Set Override Proc
  65.           call FaceIt(0,OvrCtl,fRec.cControl,%loc(OverProc),0,0)
  66.           call FaceIt(0,SetVal,1002,0,0,0)      !Set Linked Values
  67.           helpShown = .false.
  68.           do while (.true.)
  69.             call FaceIt(0,MdlWnd,1002,-2,0,0) !Process Modal Events
  70.             if (fRec.uMenuID = 0) then        !No Message
  71.               newTicks = TickCount
  72.             if (newTicks > oldTicks + 60) then
  73.               oldTicks = newTicks
  74.               call FaceIt(0,GetCtl,1002,0,2,8)
  75.               call SetCtlValue(%val(fRec.cControl),
  76.      +            %val(int2(mod(fRec.cValue,4) + 1)))
  77.             end if
  78.             else if (fRec.wvHit = 1) then      !Hit in View #1
  79.               if (fRec.wcHit = 1) then      !Hit in "OK" Button
  80.               exit
  81.             else if (fRec.wcHit = 2) then   !Hit in "Show/Hide"
  82.               if (helpShown) then
  83.                 call FaceIt(0,ShoCtl,0,0,-3,2)  !Hide v3, Show v2
  84.                 helpShown = .false.
  85.               else
  86.                 call FaceIt(0,ShoCtl,0,0,-2,3)  !Hide v2, Show v3
  87.                 helpShown = .true.
  88.               end if
  89.             end if
  90.             else if (fRec.wvHit = 2) then     !Hit in View #2
  91.               if ((fRec.wcHit = 6).or.(fRec.wcHit = 7)) then
  92.               call FaceIt(0,GetCtl,1002,0,2,int4(fRec.wcHit))
  93.               delta = 0.001 * (fRec.cMin - 2)
  94.               myRec.myReal = myRec.myReal + delta
  95.               call FaceIt(0,SetVal,1002,0,2,2)
  96.               call Delay(%val(5),fRec.uI4)
  97.             end if
  98.             end if
  99.           end do
  100.           call FaceIt(0,GetVal,1002,0,0,0)      !Get Linked Values
  101.           call FaceIt(0,EndWnd,1002,0,0,0)      !Close Nested Modal
  102.         end if
  103.         end do
  104.         call FaceIt(0,EndWnd,1001,0,0,0)  !Close Modal Window
  105. C Hit in Modeless Window's "Why ViewIt?" Button
  106.       else if ((fRec.uMenuID = 1000).and.(fRec.wcHit = 3)) then
  107.         call FaceIt(0,NewWnd,1003,0,0,%loc(theReal))
  108.         call FaceIt(0,SetVal,1003,0,0,0)
  109.         do while (.true.)
  110.           call FaceIt(0,MdlWnd,1003,0,0,0)
  111.         if (fRec.wcHit = 1) exit
  112.         end do
  113.         call FaceIt(0,GetVal,1003,0,0,0)
  114.         call FaceIt(0,EndWnd,1003,0,0,0)
  115.       end if
  116.     end do
  117.     end
  118.  
  119.     SUBROUTINE OverProc(%val(thePtr))
  120.     implicit none
  121. C NOTE: If you use the "!!G" directive for precompiled globals, add
  122. C our FaceStorLF.inc globals to yours and then remove following line
  123.     include 'FaceStorLF.inc'
  124.       record /FaceRec/ fRec
  125.       common/FaceStuff/fRec
  126.     integer*4 thePtr
  127.     if (fRec.uCommand = 264) then    !a key down message?
  128.       if (fRec.uParam(1) = 32) then  !SPACE key pressed?
  129.         fRec.uParam(1) = 95          !convert to UNDERLINE
  130.       end if
  131.     end if
  132.     call fJumpIt(%val(long(thePtr)),thePtr) !pass message to driver
  133.     end
  134.